home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE09 / CLINIC / NEWCTRLS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-15  |  3KB  |  104 lines
  1. { The OnDriveError event allows you to recover from }
  2. { the situation when you go to a drive and its not ready }
  3.  
  4. { To recover from the secondary problem, where you have }
  5. { successfully gone to drive A:, the floppy is removed }
  6. { and in attempting to go to another drive, an exception }
  7. { occurs, you must modify the VCL. In FILECTRL.PAS, locate }
  8. { TFileListBox.SetDirectory and also }
  9. { TDirectoryListBox.SetDir and change: }
  10.  
  11. (*   ChDir(FDirectory);        *)
  12.  
  13. { to be: }
  14.  
  15. (*   {$I-}  { ignore errors } *)
  16. (*   ChDir(FDirectory);       *)
  17. (*   {$I+}                    *)
  18. (*   if IOResult = 0 then;    *)
  19.  
  20. { In Delphi 2, the change has already been made for }
  21. { TDirectoryListBox.SetDir }
  22.  
  23. unit Newctrls;
  24.  
  25. interface
  26.  
  27. uses
  28.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  29.   Forms, Dialogs, StdCtrls, FileCtrl;
  30.  
  31. type
  32.   TDriveErrorEvent = procedure (Sender: TObject; var Retry: Boolean) of object;
  33.  
  34.   TNewDriveCombo = class(TDriveComboBox)
  35.   private
  36.     FOnDriveError: TDriveErrorEvent;
  37.   protected
  38.     procedure Click; override;
  39.   published
  40.     property OnDriveError: TDriveErrorEvent read FOnDriveError write FOnDriveError;
  41.   end;
  42.  
  43. procedure Register;
  44.  
  45. implementation
  46.  
  47. procedure TNewDriveCombo.Click;
  48. var
  49.   OldDrive, NewDrive: Char;
  50.   Ouch, Retry: Boolean;
  51. begin
  52.   OldDrive := Drive;
  53.   if Items.Count > 0 then
  54.     NewDrive := Items[ItemIndex][1];
  55.   Ouch := False;
  56.   { If there's a problem (empty floppy for example) }
  57.   { stop any exception message being printed }
  58.   try
  59.     inherited Click;
  60.   except
  61.     on E: EInOutError do
  62. {$ifdef Windows}
  63.       { DOS gives error 3 (Path not found) if }
  64.       { drive not ready on a directory change }
  65.       if E.ErrorCode = 3 then
  66. {$else}
  67.       { Win32 gives error 21 (Device not ready) if drive not ready }
  68.       { This is more precise - there is an equivalent error 3 defined }
  69.       { For a list of Win32 errors, (albeit with missing characters) look up }
  70.       { "error codes", "Error Codes (Win32 Programmer's Reference)" }
  71.       if E.ErrorCode = ERROR_NOT_READY then
  72. {$endif}
  73.         { Signal to later code that a problem occurred }
  74.         Ouch := True;
  75.   end;
  76.   if Ouch then
  77.     repeat
  78.       try
  79.         { Set back decent drive first }
  80.         Drive := OldDrive;
  81.         { Then check for a retry }
  82.         Retry := False;
  83.         if Assigned(FonDriveError) then
  84.           FOnDriveError(Self, Retry);
  85.         if Retry then
  86.           { Try setting target drive again }
  87.           Drive := NewDrive;
  88.         { If no exception occurs, we're done so set loop terminator }
  89.         Ouch := False;
  90.       except
  91.         { Mask the potential problem }
  92.         on E: EInOutError do
  93.           if E.ErrorCode = 3 then;
  94.       end;
  95.     until not (Ouch and Retry);
  96. end;
  97.  
  98. procedure Register;
  99. begin
  100.   RegisterComponents('Samples', [TNewDriveCombo]);
  101. end;
  102.  
  103. end.
  104.